perm filename TEST.PAS[S1,ALS] blob
sn#491656 filedate 1979-12-30 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 program TEST
C00006 ENDMK
Cā;
program TEST;
const ZERO = 0; ONE = 1; MAX = 1000000000; (* 10**9 *)
var A,A2, B, B2, C, C2, COUNT : integer;
N, X, Y, Z, LAST : integer;
PTAB : array [1..9000] of integer;
FTAB : array [1..50] of integer;
procedure PRIME;
begin
N := 11; X := 2; LAST := 4;
PTAB[1] := 2; PTAB[2] := 3; PTAB[3] := 5; PTAB[4] := 7;
while LAST < 9000 do
begin
while ((N div PTAB[X]) >= PTAB[X]) do
begin
if N mod PTAB[X] = 0 then
begin
N := N + 2; X := 2;
end
else
begin
X := X + 1;
end;
end;
LAST := LAST + 1;
PTAB[LAST] := N;
if LAST > 8995 then BEGIN writeln(tty,LAST:6,N:20); BREAK; end;
X := 2; N := N + 2;
end;
end;
function TESTN (var N2, N1 : INTEGER) : boolean;
var Y : integer;
begin
X := 1;
Y := PTAB[X];
TESTN := true;
if N2 > 0 then
begin
while (N2 >= Y) or (((N2 mod Y) * MAX + N1) div Y >= Y) do
begin
if (((N2 mod Y) * MAX + N1) mod Y) <> 0 then
begin
X := X + 1;
if X <= 9000 then Y := PTAB[X]
else writeln(tty,' PTAB overflow ');
end
else
begin
TESTN := false;
Y := MAX;
end;
end;
end
else
begin
while N1 div Y >= Y do
begin
if N1 mod Y <> 0 then
begin
X := X + 1;
Y := PTAB[X];
end
else
begin
TESTN := false;
Y := N1;
end;
end;
end;
end;
begin
PRIME;
A := 1; A2 := 0;
B := 1; B2 := 0;
COUNT := 2;
while COUNT < 50 do
begin
C := A + B; C2 := A2 + B2;
if C >= MAX then
begin
C2 := C2 + 1; C := C - MAX;
end;
A := B; A2 := B2;
B := C; B2 := C2;
COUNT := COUNT + 1;
Y := 0;
if TESTN(B2,B) then
begin
write(OUTPUT, COUNT:11);
write(tty, COUNT:11);
if B2 = 0 then
begin
writeln(TTY,' ',B:9); BREAK;
write(OUTPUT,' ',B:9);
end
else
begin
write(OUTPUT,B2:12,B:9);
writeln(TTY,B2:12,B:9); BREAK;
end;
Y := 0;
if TESTN(Y,COUNT) then writeln(OUTPUT)
else writeln(' exception');
end;
end;
end.